home *** CD-ROM | disk | FTP | other *** search
/ World of Education / World of Education.iso / world_f / fdplot.zip / T3.BAS < prev    next >
BASIC Source File  |  1992-01-06  |  6KB  |  177 lines
  1. 2000 REM Define graph position/orientation
  2. 2005 IF NF$="Y" THEN PRINT:INPUT" X min, X max for functions ";TMIN,TMAX
  3. 2050 PRINT" Rectangular or sqare plot (R/S)? _";:GOSUB 8000
  4. 2060 IF A$<>"R" AND A$<>"S" THEN 2050
  5. 2070 IF A$="S" THEN XLN%=YLN%*(1+INT(200/SZY%))
  6. 2090 PRINT:PRINT" SCALES: Regular, Grid or None? (R/G/N) _";:GOSUB 8000
  7. 2095 IF A$<>"R" AND A$<>"G" AND A$<>"N" THEN 2090
  8. 2100 SC$=A$
  9. 2105 IF SC$="N" THEN GOTO 2117
  10. 2110 PRINT:INPUT" Enter X-title (max 20 characters) or ─┘ ",XTITLE$
  11. 2115 INPUT" Enter Y-title (max 20 characters) or ─┘ ",YTITLE$
  12. 2117 IF NF$="Y" THEN INPUT " Function detail? (-1 to +1, or ─┘) ";DTL
  13. 2120 CLS
  14. 2125 REM PLOT X TITLE
  15. 2130 IF LEN(XTITLE$)=0 THEN 2150
  16. 2142   LOCATE (25+YADD%),40
  17. 2145   PRINT XTITLE$;
  18. 2150 REM END XTITLE
  19. 2155 REM PLOT Y TITLE
  20. 2160   IF LEN(YTITLE$)=0 THEN 2185
  21. 2175   LOCATE 1,2
  22. 2180   PRINT YTITLE$;
  23. 2185 REM END YTITLE
  24. 2190 RETURN
  25. 3000 REM Functions/data-sets retrieval, plot axes and scales
  26. 3050 REM Retreive data sets
  27. 3055 IF ND$="N" THEN 3115
  28. 3065     FM$="PLOTD"
  29. 3070     OPEN "I",#1,FM$
  30. 3075     INPUT #1,DTSN
  31. 3085     FOR J=1 TO DTSN
  32. 3090         INPUT #1,DATX(J),DATY(J)
  33. 3095     NEXT J
  34. 3100     INPUT #1,CORL$
  35. 3105     CLOSE #1
  36. 3115 REM FIND DATA SET MAX/MIN
  37. 3120 IF ND$="N" THEN 3180
  38. 3125   TEMP=DATX(1):TEMP2=DATY(1)
  39. 3130   XMIN=TEMP:XMAX=TEMP
  40. 3135   YMIN=TEMP2:YMAX=TEMP2
  41. 3145     FOR J=1 TO DTSN
  42. 3150       IF DATX(J)<XMIN THEN XMIN=DATX(J)
  43. 3155       IF DATX(J)>XMAX THEN XMAX=DATX(J)
  44. 3160       IF DATY(J)<YMIN THEN YMIN=DATY(J)
  45. 3165       IF DATY(J)>YMAX THEN YMAX=DATY(J)
  46. 3170     NEXT J
  47. 3180 REM END DATA MAX/MIN
  48. 3185 REM FIND FUNCTIONS MAX/MIN
  49. 3190 IF NF$="N" THEN 3265
  50. 3200   IF ABS(DTL) > .88 THEN DTL=SGN(DTL)*.88
  51. 3203   DTL=SGN(DTL)*SQR(ABS(DTL))
  52. 3205   TINC=(TMAX-TMIN)/50/(1.1+DTL)*(1.1-DTL) 'Try 50 divisions for functions
  53. 3210   T=TMIN:X=T:GOSUB 1100
  54. 3215   IF ND$="N" THEN YMIN=Y:YMAX=Y:XMIN=X:XMAX=X
  55. 3220   FOR T=TMIN TO TMAX STEP TINC
  56. 3225       X=T
  57. 3235       GOSUB 1100
  58. 3240       IF Y<YMIN THEN YMIN=Y
  59. 3245       IF Y>YMAX THEN YMAX=Y
  60. 3250       IF X<XMIN THEN XMIN=X
  61. 3255       IF X>XMAX THEN XMAX=X
  62. 3260   NEXT T
  63. 3265 REM END FUNCT TEST
  64. 3270 REM DRAW SCALES AND AXES
  65. 3280 REM SELECT Y SCALES
  66. 3285 A=LOG(YMAX-YMIN)*.434294:IF A<0 THEN A1=A+ABS(INT(A)) ELSE A1=A-INT(A)
  67. 3290 A2=10^(A-A1):YF=A2 '
  68. 3295 A3=INT(YMIN/A2) '
  69. 3300 A4=A3*A2 '
  70. 3305 SY=INT(YMAX/A2+.95)-A3 '
  71. 3310 NTC%=.007*SZY%
  72. 3315 IF SY<5 THEN RN=.5 ELSE RN=1 '
  73. 3317 IF SY=1 THEN RN=.2
  74. 3320 IF SC$="N" THEN 3400
  75. 3325 FOR RI=0 TO SY STEP RN
  76. 3330 REM PRINT SCALE #'S
  77. 3335 XPP=-.041*SZX%:YPP=RI*YLN%/SY-NTC% '
  78. 3340 GOSUB 6000
  79. 3350 YTITLE$=STR$(A3+RI)
  80. 3355 PRINT YTITLE$
  81. 3360 REM
  82. 3365 MOVE$="B"
  83. 3370 IF SC$="R" THEN XPP=NTC%*4 ELSE XPP=XLN%
  84. 3372 YPP=YPP+NTC%:GOSUB 5010
  85. 3375 XPP=0:GOSUB 5010
  86. 3380 IF RI=SY THEN 3390
  87. 3385   YPP=(RI+RN)*YLN%/SY:GOSUB 5010
  88. 3390 NEXT RI
  89. 3400 REM SELECT X SCALES
  90. 3405 B=LOG(XMAX-XMIN)*.434294:IF B<0 THEN B1=B+ABS(INT(B)) ELSE B1=B-INT(B)
  91. 3410 B2=10^(B-B1):XF=B2
  92. 3415 B3=INT(XMIN/B2)
  93. 3420 B4=B3*B2
  94. 3425 SX=INT(XMAX/B2+.95)-B3
  95. 3430 IF SX<5 THEN RN=.5 ELSE RN=1
  96. 3433 IF SX=1 THEN RN=.2
  97. 3435 TEMPX=XLN%/SX/XF:TEMPY=YLN%/SY/YF
  98. 3440 IF SC$="N" THEN 3515
  99. 3445 FOR RI=0 TO SX STEP RN
  100. 3450 REM
  101. 3455 YPP=-5*NTC%:XPP=RI*XLN%/SX-2*NTC% 
  102. 3460 GOSUB 6000 
  103. 3465 XTITLE$=STR$(B3+RI)
  104. 3466 IF (B3+RI>=0) THEN XTITLE$=MID$(STR$(B3+RI),2)
  105. 3470 PRINT XTITLE$;
  106. 3475 REM
  107. 3472 MOVE$="B"
  108. 3480 IF SC$="R" THEN YPP=4*NTC% ELSE YPP=YLN%
  109. 3485 XPP=XPP+2*NTC%:GOSUB 5010
  110. 3490 YPP=0:GOSUB 5010 ' write notch
  111. 3495 IF RI=SX THEN 3510
  112. 3500   XPP=(RI+RN)*XLN%/SX:GOSUB 5010
  113. 3510 NEXT RI
  114. 3515 REM
  115. 3520 REM
  116. 3525 IF SC$="N" THEN RETURN
  117. 3530 XTITLE$="(Scale: X/"+MID$(STR$(XF),2)+", Y/"+MID$(STR$(YF),2)+")"
  118. 3535 LOCATE (25+YADD%),5
  119. 3540 PRINT XTITLE$;
  120. 3545 RETURN
  121. 4000 IF NF$="N" THEN 4110
  122. 4005 REM
  123. 4010 STP=.02*SZX%/(1.1+DTL)*(1.1-DTL)
  124. 4015 T=TMIN:GOSUB 1100
  125. 4020 GOSUB 5040
  126. 4025 X1=X%:Y1=Y%:TINCTMP=TINC
  127. 4028 T=TMIN+TINC:GOSUB 1100
  128. 4030   GOSUB 5040
  129. 4032   X2=X%:Y2=Y%:TS1=SQR((X1-X2)^2+(Y1-Y2)^2)
  130. 4033   IF TS1<.5 THEN TINC=TINC+TINCTMP:GOTO 4028
  131. 4035   IF TS1>STP THEN TINC=.9*TINC: GOTO 4028 
  132. 4040 REM PLOTF
  133. 4050   T=TMIN:GOSUB 1100
  134. 4055   CLR$="C"+STR$(240) 'curve colour
  135. 4056   DRAW CLR$
  136. 4060   MOVE$="B":GOSUB 5000
  137. 4075   FOR T=TMIN+TINC TO TMAX STEP TINC
  138. 4080     GOSUB 1100
  139. 4085     GOSUB 5000
  140. 4095   NEXT T 
  141. 4100 REM
  142. 4110 IF ND$="N" THEN 4210' plot data sets
  143. 4112 DRAW "C255"
  144. 4125   FOR J=1 TO DTSN
  145. 4130     X=DATX(J):Y=DATY(J):MOVE$="B":GOSUB 5000
  146. 4140     GOSUB 7100
  147. 4205   NEXT J
  148. 4210 REM 
  149. 4215 WHILE INKEY$="":WEND 'after plot wait for any key to be pressed.
  150. 4220 RETURN                     
  151. 5000 REM normal math coords -> plotter abs coords
  152. 5005 YPP=(Y-A4)*TEMPY:XPP=(X-B4)*TEMPX
  153. 5010 REM translate axes, & plot
  154. 5015 X%=XPP+HT%
  155. 5020 Y%=SZY%-(YPP+KT%)'Note screen y is downward in IBM-PC.
  156. 5025 REM Change coordinates into "plotting" form and send
  157. 5030 MOVE$=MOVE$+"M"+STR$(X%)+","+STR$(Y%)
  158. 5032 DRAW MOVE$
  159. 5035 MOVE$="" : RETURN    'RESET "pen up" to "down"
  160. 5040 REM TRANSL ONLY
  161. 5045 YPP=(Y-A4)*TEMPY:XPP=(X-B4)*TEMPX
  162. 5050 X%=XPP+HT%
  163. 5055 Y%=SZY%-(YPP+KT%):RETURN
  164. 6000 X%=XPP+HT% 'Locate nearest ascii spot
  165. 6010 Y%=SZY%-(YPP+KT%)
  166. 6020 ROW%=(Y%/SZY%*(25+YADD%)+.5):COL%=(X%/SZX%*80+.5)
  167. 6030 LOCATE ROW%,COL% :RETURN
  168. 7100 REM draw data symb1
  169. 7105 A$="BE2;D4;L4;U4;R4"
  170. 7110 DRAW A$
  171. 7199 RETURN
  172. 8000 A$=INKEY$:IF (A$="") GOTO 8000
  173. 8010 IF (ASC(A$)> 96) THEN A$=CHR$(ASC(A$)-32)
  174. 8020 PRINT A$: RETURN
  175. 9000 PRINT" If not VMODE selection error then Function/data definition error."
  176. 9005 PRINT"    Press ─┘ for menu ";: INPUT"",A$: CHAIN "MENU"
  177.